Cream of the Crop 3/Cream of the Crop 3.iso/comm/prtcs155.zip/USERUL.WPL

Text File | 1994-01-14 | 5KB | 192 lines

/**/
v="$VER:  UserUL Wplrx    Get user upload descriptions   Williamson 54.09"
/* Non-Secure Inbound directory     */
/* Mail:Inbound/nonsecure/          */
indir=addslash(dequote(getclip('INDIR')))||'NONSECURE/'
/* TAGNAME of your SYSOP Feedback message base */
sysopbase=GetClip('SYSOPBASE')
/* Your name */
sysop=GetClip('SYSOP')
rpath=addslash(dequote(GetClip('REXXDIR')))
options RESULTS
options failat 99
signal on syntax
signal on halt
signal on ioerr
signal on break_c
signal on break_d

pragma("W","NULL")
/* Check if ROOFLOG port is available */
log=show('P','ROOFLOG')

sv      = 'v'||right(v,5)
script  = "UserUL"
mailer=GetCLip('SHELTER')
l_mailer=lower(mailer)

cr    = '\r\n'  /* WPL */
nl    = '0a'X   /* REXX */
bs    = '08'x
quote = '"'

tmsg="T:User-"pragma('ID')

parse arg username

filefile='LOG:needdesc'
if upper(username)="USER" then username="Unknown User"

if ~exists(filefile) then exit
if ~open('rf',filefile,'r') then exit

do while ~eof('rf')
    x=readln('rf')
    if x="" then iterate
    if words(x) ~= 2 then call PutLog("error:" x,10,10)
    parse var x remfile localfile
    desc=strip(wpl_prompt(200,cr||'Please describe 'remfile' (max: 79 characters)'||cr))
    call PutLog('File:'localfile' Desc:'desc,10,10)
    address COMMAND "FileNote" localfile '"'||desc||'"'
    drop desc
    x=upper(wpl_prompt(120,'Would you like to enter a long description? (y/N) '))
    if x="Y" then call feedback
end
call close('rf')
call delete(filefile)
call send(cr||'Bye and Thanks for the uploads 'username||cr)
exit


/* feedback to sysop */
feedback:
    call send(cr||' To:                  'sysop)
    call send(cr||' From:                'username)
    call send(cr||' Subject:             'remfile)

    call send(cr||' Enter your message one line at a time.'||cr)
    call send(cr||' Hit CR to select Save or continue.'||cr)

    call open('smsg',tmsg,"W")
    call writech('smsg'," Long Description for "remfile" from "username" Posted:"date()" at "time()||nl)
    editing=1
    line=1
    c=0
    do while editing
        do while resp ~= ""
            'CheckCarrier'
            if RC~=0 then leave
            resp=wpl_prompt(200,"-->"line": ")
            if resp ~= "" then do
                chars=writech('smsg',resp||nl)
                c=c+chars
                line=line+1
            end
        end /* hit a blank line */
        'CheckCarrier'
        if RC~=0 then do
            call writech('smsg','User' username 'dropped carrier during feedback'||nl)
            call PutLog('User' username 'dropped carrier during feedback',10,10)
            call save_msg
            call cleanup
            exit
        end
        resp=wpl_prompt(120,cr||' You entered 'line-1' lines and 'chars' characters (total:'c'), [S]ave/[c]ontinue?'||cr)
        if upper(resp)="S" then editing=0
    end  /* finished editing */

    call writech('smsg',nl)
    call close('smsg')
    call PutLog('Saving message from 'username' in 'sysopbase,10,10)
    call send(cr||' Saving......')
    if exists("RPDIR:SMSG") then do
        cmd='RUN SMSG 'sysopbase tmsg '"'username'"' '"'sysop'"' remfile
        address COMMAND cmd
    end;else do
        cmd=rpath'Smsg.rexx' sysopbase tmsg '"'username'"' '"'sysop'"' remfile
        call PutLog('Executing:' cmd,10,10)
        Address "AREXX" cmd
    end
    address

    call send(cr||' Message saved, thanks' username||cr)
return 0


send:
    'Print' quote||arg(1)||quote
    'Send' quote||arg(1)||quote
return

wpl_prompt:
    'Print' quote||arg(2)||quote
    'Send' quote||arg(2)||quote
getstring:
    'GetInbound E0 'arg(1)
    'String $(event)'
    if upper(RESULT) = 'CARRIER' then do
        'RexxMsg NY "LOGPROC" "PutLog 'l_mailer'wpl $<time> $(line) UserUL $(remote.address) Lost Carrier"'
        call PutLog('User 'username' dropped carrier',10,10)
        call cleanup
        exit
    end;else if upper(RESULT) = 'LOGIN' then do
        'String $(namebuf)'
        x=(RESULT)
    end;else x=""
return x

get_fn:
    if LastPos('/', arg(1)) ~= 0 then return SubStr(arg(1), LastPos('/', arg(1)) + 1)
        else if LastPos(':', arg(1)) ~= 0 then return SubStr(arg(1), LastPos(':', arg(1)) + 1)
            else return arg(1)
lower:
return(bitor(arg(1),'20'x))

PutLog:  procedure expose log script
    if arg(2) > GetClip('LOGLEVEL') & ~log then return 0
    address 'ROOFLOG' 'logline' left(time(),5) script': 'arg(1)
    address
return 0

addslash:
    curr = arg(1)
    select
        when right(curr, 1) = ":" then nop
        when right(curr, 1) = "/" then nop    /* TackOn */
            otherwise curr = curr"/"
    end
return curr

/* a useful procedure by Walt Sullivan    */
dequote:
    parse arg thing
    parse var thing '"' unq_thing '"'
    if unq_thing ~= "" then return unq_thing
return thing

cleanup:
return 0
break_c:
break_d:
    PutLog('User abort',10,10)
    call cleanup
    exit 10
novalue:
        call template_oops "Novalue" sigl
syntax:
        call template_oops "Syntax(RC=" || RC || ")" sigl RC
failure:
        call template_oops "Failure(RC=" || RC || ")" sigl
ioerr:
        call template_oops "IOErr" sigl
halt:
        call template_oops "Halt" sigl

template_oops:
        parse arg what badline code
        if code ~= "" then PutLog('ERR: Line 'badline what errortext(code),10,10)
            else PutLog('ERR: Line' badline what,10,10)
        call cleanup
        exit(40)
/**/